home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Amiga Collections: Franz PD
/
Franz PD Disk #324 (1994-04)(Rhein-Sieg-Soft).zip
/
Franz PD Disk #324 (1994-04)(Rhein-Sieg-Soft).adf
/
VideoText3.5
/
source
/
VideoText.p
< prev
next >
Wrap
Text File
|
1994-04-01
|
8KB
|
253 lines
PROGRAM VideoText;
FROM vt USES global,sys,startup,jobs,bildschirm,datei;
{$ulink "vt/s_i2cbusIO.o" }
{ Hauptprogramm/Ereignisverwaltung zum Projekt VideoText }
CONST version = '$VER: VideoText V3.5 (01.04.94)';
VAR l: Long;
testing: Boolean;
roundrobin, active: Byte; { active: Summe der aktiven Jobs }
eingabe, s: Str80;
taste,ch: Char;
j: Integer;
PROCEDURE handle_key(key: char);
{ der Übersichtlichkeit halber aus dem Hauptprogramm herausgezogen }
var j,ok,ft: integer;
s: String[20];
begin
mainline;
case key of
'0'..'9','/': if length(eingabe) < 8 then
eingabe := eingabe + key;
#8: if length(eingabe) > 0 then
eingabe := copy(eingabe,1,length(eingabe)-1);
#13: begin
add_job(eingabe);
redraw_queue(-1);
eingabe := '';
end;
'x': begin
sleep;
mainline; write('Wirklich aufh|ren? ');
if ja_nein then stop := true;
wakeup;
end;
't': begin
testing := not testing;
if not testing then test(false);
end;
'i': begin
sleep; scanpages; redraw_all; wakeup;
end;
's': IF (thispage<>Nil) AND NOT protokoll THEN BEGIN
sleep;
fileinfo;
ft := filetype(outputname); mainline;
{ Sicherheitsprüfungen: Überschreiben nur mit Bestätigung ... }
IF overwrite OR (AsciiRawIff=3) THEN BEGIN
IF ft<>-1 THEN BEGIN
write(']berschreiben - sicher? ');
IF NOT ja_nein THEN BEGIN wakeup; exit; END;
END;
{ ... Anhängen nur an geeignete Dateien: }
END ELSE BEGIN
Write(#155'33m');
IF ft IN [2,3] THEN BEGIN
IF ft=2 THEN Write('Programmdatei') ELSE Write('IFF-Datei');
Write(', Anh{ngen unzul{ssig!');
wakeup; exit;
END;
IF (AsciiRawIff=2) AND NOT (ft IN [1,-1]) THEN BEGIN
Write('VT nur an VT-Format anh{ngen!');
wakeup; exit;
END;
END;
mainline; busy_pointer;
write('Seite ',thispage^.pg,'/',thispage^.sp,' ...');
if savepage(thispage,outputname) then
write(' gespeichert.')
else begin
mainline; Write(#155'33m');
write('Dateifehler - sorry!');
end;
normal_pointer;
wakeup;
end;
'n': BEGIN
sleep;
IF fileselect('Ausgabedatei festlegen',true,outputname) THEN;
cursoroff; { wurde von fileinfo evtl. eingeschaltet }
fileinfo;
wakeup;
END;
'f': IF NOT protokoll THEN BEGIN
AsciiRawIff := AsciiRawIff MOD 3 + 1;
fileinfo;
END;
'm': IF NOT protokoll AND (AsciiRawIff<>3) THEN BEGIN
overwrite := NOT overwrite;
fileinfo;
END;
'p': BEGIN
protokoll := NOT protokoll;
fileinfo; ft := filetype(outputname);
IF protokoll AND (ft IN [2,3]) THEN BEGIN
mainline; Write(#155'33m');
IF ft=2 THEN Write('Programm') ELSE Write('IFF');
Write(' nicht als Protokolldatei!')
protokoll := False; fileinfo;
END;
END;
#127: if thispage<>Nil then begin { Del: eine Seite löschen }
del_from_list(thispage);
redraw_list;
writepage(Nil,true);
end;
{ +/-: Jobauswahl markieren }
'+': IF thisjob>-queued THEN BEGIN
Dec(thisjob);
mark_queue(thisjob+1);
IF thisjob>=0 THEN BEGIN
aktspeicher := thisjob; display_select(aktspeicher); END;
END;
'-': IF thisjob<maxactive-1 THEN BEGIN
Inc(thisjob);
mark_queue(thisjob-1);
IF thisjob>=0 THEN BEGIN
aktspeicher := thisjob; display_select(aktspeicher); END;
END;
'u': IF thisjob>=0 THEN BEGIN { einen Job zum Untertitel ernennen }
WITH activejobs[thisjob] DO
IF ist_UT=0 THEN ist_UT := $04 ELSE ist_UT := 0;
redraw_queue(thisjob);
END;
'*': begin { einen Job löschen }
if thisjob>=0 then begin
activejobs[thisjob].pg := 0;
sperren(thisjob);
redraw_queue(thisjob);
end;
if (thisjob<0) and (thisjob>=-queued) then begin
for j := -thisjob to queued-1 do
queue[j] := queue[j+1];
Dec(queued);
redraw_queue(-1);
end;
end;
' ': writepage(thispage,true);
'?': writepage(thispage,false);
otherwise begin
mainline; write('f}r Anleitung '#155'33mHELP'#155'37m dr}cken!');
end;
end;
end;
PROCEDURE handle_escseq(chars: str80);
{ wie handle_key, aber für die ESC-Sequenzen der Sondertasten }
VAR i,page,page2: integer;
begin
mainline;
if (chars='7~') then begin { F8: Seiten wegwerfen }
sleep; Write('Alle Seiten wegwerfen? ');
if ja_nein then begin
kill_list; redraw_list;
thispage := Nil; writepage(Nil,True);
end;
wakeup;
end else if (chars='8~') then begin { F9: Jobs killen }
queued := 0;
FOR i := 0 TO maxactive-1 DO BEGIN
activejobs[i].pg := 0;
sperren(i);
END;
redraw_queue(-1);
END ELSE IF chars='9~' THEN BEGIN { F10: VT.config lesen }
busy_pointer; getconfig;
normal_pointer;
END else if (chars='0~') then { F1 }
TV_display(2)
else if (chars='1~') then { F2 }
TV_display(1)
else if (chars='2~') then { F3 }
TV_display(0);
if (chars='?~') then begin { Help }
sleep; displayhelp; redraw_all; wakeup;
exit;
end;
{ Cursor: Seitenliste durchblättern }
if pos(chars,'ABCDST')>0 then begin
mark_list(false);
if thispage<>Nil then begin
if (chars='A') then
if (thispage^.prev<>Nil) then
thispage := thispage^.prev;
if (chars='B') then
if (thispage^.next<>Nil) then
thispage := thispage^.next;
if (chars='C') then for i := 1 to qlen do
if (thispage^.next<>Nil) then
thispage := thispage^.next;
if (chars='D') then for i := 1 to qlen do
if (thispage^.prev<>Nil) then
thispage := thispage^.prev;
if chars='S' then
thispage := next_magazine(thispage);
if chars='T' then
thispage := prev_magazine(thispage);
end;
mark_list(true);
writepage(thispage,true);
exit;
end;
end;
BEGIN { Hauptprogramm }
{ Eine Menge Variablen werden bereits in den Units, wo sie auch definiert }
{ sind, initialisiert. }
get_args; { u. a. Namen für Ausgabedatei holen }
AddExitServer(sysclean); sysinit(version);
init_CCT; { SAA 5246 initialisieren }
active := 0; FOR j := 0 TO maxactive-1 DO activejobs[j].pg := 0;
roundrobin := 0; testing := False; stop := False;
lastkey := #0; eingabe := '';
cursoroff;
redraw_all;
REPEAT
GotoXY(2,queued+4+maxactive); Write(#155'37m',eingabe,#155'7m '#155'0m ');
IF (thispage=Nil) AND (root<>Nil) THEN BEGIN
thispage := root;
writepage(thispage,True);
END;
IF lastkey=#0 THEN
taste := readkey
ELSE BEGIN
taste := lastkey; lastkey := #0;
END;
IF taste=#155 THEN BEGIN { Sondertasten auswerten }
s := '';
REPEAT
ch := readkey; IF ch<>#0 THEN s := s + ch;
UNTIL ch = #0;
handle_escseq(s);
END ELSE IF taste<>#0 THEN
handle_key(taste)
ELSE BEGIN
Delay(2); { Multitasking-freundlich! }
IF testing THEN test(True);
IF (queued+active=0) AND NOT testing THEN l := Wait(-1);
IF (active>0) AND (taste=#0) THEN attempt_input(roundrobin);
IF queued+active>0 THEN BEGIN handle_queue; handle_jobs; END;
active := 0;
FOR j := 0 TO maxactive-1 DO
IF (activejobs[j].pg>0) THEN Inc(active);
roundrobin := (roundrobin+1) MOD maxactive;
END;
stop := stop OR abbruch_test;
UNTIL stop;
SetStdIO(Nil); CloseConsole(Con);
kill_list; sysclean;
END.